Gigantic Games 2/Gigantic Games 2.iso/pc/_a_/abitur/txt/initialisierespieler.mod

Text File | 1994-12-23 | 6KB | 235 lines

IMPLEMENTATION MODULE InitialisiereSpieler;


FROM AbiturScreen IMPORT weisS, AddAbiTxtLin, ShowAbiTxt;
FROM Menus IMPORT RefreshSpielerMenu, CH;
FROM Arts IMPORT TermProcedure, Assert;
FROM Exec IMPORT FreeMem, MemReqSet, MemReqs, AllocMem;
FROM RandomNoten IMPORT RNDNote;
FROM IntuFrage IMPORT IntuFrag;
FROM Fragen IMPORT Frage, FragePtr, SchuelerAntwort;
FROM Str IMPORT Copy, Length;
FROM Globals IMPORT AlleSpieler, AnzahlSpieler, Noten, SpielerPtr, Spieler,
                    FindSpieler;
FROM FaecherNamen IMPORT FaecherTypen;
FROM SYSTEM IMPORT ADR;
FROM Intuition IMPORT IntuiTextPtr, WindowPtr;
FROM Graphics IMPORT Move, Text, SetAPen;
FROM BerechneSchnitt IMPORT BerechneSchnitt;


PROCEDURE InitRNDVornote(VAR V: Noten);
VAR i: FaecherTypen;
BEGIN
   FOR i := Turnen TO Informatik DO
      V[i] := RNDNote()
   END
END InitRNDVornote;



PROCEDURE ClearNoten(VAR N: Noten);
VAR i: FaecherTypen;
BEGIN
   FOR i := Turnen TO Informatik DO
      N[i] := 0.0
   END
END ClearNoten;


PROCEDURE GetNextPlayerName(VAR S: ARRAY OF CHAR): BOOLEAN;
VAR Fr: Frage;
    MyAnt: SchuelerAntwort;
    i: INTEGER;
    W: WindowPtr;
BEGIN (* TEst *)

   Fr.Next := NIL;

   Copy(Fr.Txt[0], "Name des Schülers");
   FOR i := 1 TO 10 DO
      Fr.Txt[i][0] := 0C
   END;
   Copy(Fr.MultipleAntw[1], "Fertig");
   FOR i := 2 TO 6 DO
      Fr.MultipleAntw[i][0] := 0C
   END;

   REPEAT
      IntuFrag(ADR(Fr), MyAnt);
      Copy(S, MyAnt.Str)
   UNTIL (Length(MyAnt.Str)#0) OR (0 IN MyAnt.Mul);

   IF (Length(MyAnt.Str) # 0) AND (0 IN MyAnt.Mul) THEN
      AddAbiTxtLin("Zum beenden 'Fertig' an-");
      AddAbiTxtLin("wählen und keinen Namen");
      AddAbiTxtLin("mehr eingeben! Dann (OK)!");
      ShowAbiTxt(weisS)
   END;

   (* String abhacken, falls zu lang: *)
   S[13] := 0C;
   RETURN NOT ( (0 IN MyAnt.Mul) AND (Length(MyAnt.Str) = 0) )
END GetNextPlayerName;



PROCEDURE FreeAllPlayers;
VAR Temp : SpielerPtr;
BEGIN
   WHILE AlleSpieler # NIL DO
      Temp := AlleSpieler;
      AlleSpieler := AlleSpieler^.Next;
      FreeMem(Temp, SIZE(Spieler))
   END;
   AnzahlSpieler := 0
END FreeAllPlayers;


PROCEDURE WritePsstText(h: INTEGER);
VAR W: WindowPtr;
    S: SpielerPtr;
BEGIN
   S := FindSpieler(h);
   AddAbiTxtLin("Psst! Hey");
   AddAbiTxtLin(S^.Name);
   AddAbiTxtLin("komm mal alleine");
   AddAbiTxtLin("her!");
   ShowAbiTxt(weisS)
END WritePsstText;



PROCEDURE AddSympNote(i, j :INTEGER);
VAR Si, Sj: SpielerPtr;
    Fr: Frage;
    l: INTEGER;
    Antw: SchuelerAntwort;
BEGIN
   Si := FindSpieler(i);
   Sj := FindSpieler(j);
   Fr.Next := NIL;
   FOR l := 0 TO 10 DO
      Fr.Txt[l][0] := 0C
   END;
   Copy(Fr.Txt[0], Si^.Name);
   Copy(Fr.Txt[1], "gib Sympathienote");
   Copy(Fr.Txt[2], "für");
   Copy(Fr.Txt[3], Sj^.Name);
   Copy(Fr.Txt[4], " !!! ");
   FOR l := 1 TO 6 DO
      Fr.MultipleAntw[l][0] := CHR(ORD("0") + l);
      Fr.MultipleAntw[l][1] := 0C
   END;
   IntuFrag(ADR(Fr), Antw);
   FOR i := 5 TO 0 BY -1 DO
    IF CH() THEN
      IF i IN Antw.Mul THEN
         Sj^.SympathieNoteTurnen :=
              Sj^.SympathieNoteTurnen + FLOAT(i + 1) /
                                           FLOAT(AnzahlSpieler - 1);
             (* AnzSp-1 > 0, da AddSympNote nur gerufen wird bei
              * mehreren Spielern.
              *)
          RETURN
      END
    ELSE
      IF i IN Antw.Mul THEN
         Sj^.SympathieNoteTurnen :=
              Sj^.SympathieNoteTurnen + FLOAT(6-i) /
                                           FLOAT(AnzahlSpieler - 1);
             (* AnzSp-1 > 0, da AddSympNote nur gerufen wird bei
              * mehreren Spielern.
              *)
          RETURN
      END
    END
   END;
   Sj^.SympathieNoteTurnen := 3.5
END AddSympNote;



PROCEDURE InitPlayers;
VAR dummy : BOOLEAN;
    i: FaecherTypen;
    A,B,C: IntuiTextPtr;
    NeuName: ARRAY[0..36] OF CHAR;
    AktSpieler: SpielerPtr;
    W,TextW: WindowPtr;
    h,k:INTEGER;
BEGIN
   FreeAllPlayers;
   AddAbiTxtLin("Alle Schüler(innen) geben ihren");
   AddAbiTxtLin("Namen ein. Danach (RETURN).");
   AddAbiTxtLin("Am Schluß: [Fertig] anwählen");
   AddAbiTxtLin("und OK klicken.");
   ShowAbiTxt(weisS);
   REPEAT (* Bis mindestens ein Spieler dabei *)
      WHILE (AnzahlSpieler < 20) AND GetNextPlayerName(NeuName) DO
         AktSpieler := AllocMem(SIZE(Spieler), MemReqSet{public});
         IF AktSpieler # NIL THEN
            INC(AnzahlSpieler);
            WITH AktSpieler^ DO
               Next := AlleSpieler;
               Copy(Name, NeuName);
               Jahr := 0;
               WITH Zeugnis DO
                  InitRNDVornote(VorNote);
                  ClearNoten(AktuelleSumme);
                  ClearNoten(Schnitt);
                  FOR i := Turnen TO Informatik DO
                     AnzInSumme[i] := 0
                  END;
                  GesammtSchnitt := 0.0
               END;
               SympathieNoteTurnen := 0.0;
               ErfahrungsNoteGs := Zeugnis.VorNote[Geschichte];
               Absenzen := 0;
               Provisorisch := 0
            END; (* WITH *)
            BerechneSchnitt(AktSpieler);
            AlleSpieler := AktSpieler
         ELSE
            AddAbiTxtLin("Nicht mehr Spieler");
            ShowAbiTxt(weisS)
         END (* IF *)
      END; (* WHILE *)
      IF AnzahlSpieler = 0 THEN
            AddAbiTxtLin("Brauche mindestens einen Schüler");
            ShowAbiTxt(weisS)
      END
   UNTIL AnzahlSpieler > 0;
   IF AnzahlSpieler >= 20 THEN
      AddAbiTxtLin("Sorry, nur 20 Spieler!");
      ShowAbiTxt(weisS)
   END;
   IF RefreshSpielerMenu() THEN END;

  (* Turnen Symathienote bestimmen *)
   IF AnzahlSpieler > 1 THEN
      FOR h := 1 TO AnzahlSpieler DO
         WritePsstText(h);
         FOR k := 1 TO AnzahlSpieler DO
            IF h # k THEN
               AddSympNote(h, k)
               (* Spieler h gibt seine sympatischen Teil An Spieler k *)
            END
         END
      END
   ELSE
      AlleSpieler^.SympathieNoteTurnen := RNDNote()
   END
END InitPlayers;





BEGIN
 AlleSpieler := NIL;

 TermProcedure(FreeAllPlayers)

END InitialisiereSpieler.